Reading Data

library(here)
movies <- read.csv(here("datasets", "movie_metadata.csv"))
gmsc_train <- read.csv(here("datasets", "gmsc_cs-training.csv"))

Setup Test/Train

train_idx <- sample(1:nrow(movies), size = floor(0.75 * nrow(movies)))
movies_train <- movies %>% slice(train_idx)
movies_test <- movies %>% slice(-train_idx)

Where 0.75 is the percentage (75%) of the data to put in the Training set.

Containers

# sequences
seq(1, 20)

 [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20

mySeq <- seq(1, 20, by = 3)
str(mySeq)

 num [1:7] 1 4 7 10 13 16 19

# vector
myVec <- c(1, 2, 3, 4, 100, 58, 5568)
myVec

[1]    1    2    3    4  100   58 5568

str(myVec)

 num [1:7] 1 2 3 4 100 ...

# character
myChar <- "hey!"
myChar

[1] "hey!"

vector_char <- c("jon", "Peter", "Sam")
vector_char

[1] "jon"   "Peter" "Sam"  

str(vector_char)

 chr [1:3] "jon" "Peter" "Sam"

my_vec2 <- c(1, 3, 4, "Sam")

Factors

birth_month <- c("Dec", "May", "Apr", "Dec")
str(birth_month)

 chr [1:4] "Dec" "May" "Apr" "Dec"

birth_month <- factor(birth_month)
str(birth_month)

 Factor w/ 3 levels "Apr","Dec","May": 2 3 1 2

table(birth_month)

birth_month
Apr Dec May 
  1   2   1 

month_levels <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", 
    "Oct", "Nov", "Dec")
birth_month <- factor(birth_month, levels = month_levels)
str(birth_month)

 Factor w/ 12 levels "Jan","Feb","Mar",..: 12 5 4 12

unique(birth_month)

[1] Dec May Apr
Levels: Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec

table(birth_month)

birth_month
Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec 
  0   0   0   1   1   0   0   0   0   0   0   2 

Filter

Can Use | as or

library("tidyverse")
table(movies$language)

           Aboriginal     Arabic    Aramaic    Bosnian  Cantonese 
        12          2          5          1          1         11 
   Chinese      Czech     Danish       Dari      Dutch   Dzongkha 
         3          1          5          2          4          1 
   English   Filipino     French     German      Greek     Hebrew 
      4704          1         73         19          1          5 
     Hindi  Hungarian  Icelandic Indonesian    Italian   Japanese 
        28          1          2          2         11         18 
   Kannada     Kazakh     Korean   Mandarin       Maya  Mongolian 
         1          1          8         26          1          1 
      None  Norwegian    Panjabi    Persian     Polish Portuguese 
         2          4          1          4          4          8 
  Romanian    Russian  Slovenian    Spanish    Swahili    Swedish 
         2         11          1         40          1          5 
     Tamil     Telugu       Thai       Urdu Vietnamese       Zulu 
         1          1          3          1          1          2 

movies_language <- movies %>% filter(language == "Arabic")
movies_language

  color  director_name num_critic_for_reviews duration
1 Color    Serdar Akar                     16      122
2 Color Jehane Noujaim                     68      108
  director_facebook_likes actor_3_facebook_likes   actor_2_name
1                      11                    173 Bergüzar Korel
2                      63                      5   Ahmed Hassan
  actor_1_facebook_likes gross                         genres
1                    205    NA               Action|Adventure
2                    161    NA Documentary|Drama|History|News
    actor_1_name                 movie_title num_voted_users
1  Necati Sasmaz Valley of the Wolves: Iraq            14486
2 Khalid Abdalla                 The Square             6678
  cast_total_facebook_likes    actor_3_name facenumber_in_poster
1                       808 Ghassan Massoud                    3
2                       176   Aida Elkashef                    0
                             plot_keywords
1 abu ghraib|bomb|christian|explosion|iraq
2                                         
                                       movie_imdb_link
1 http://www.imdb.com/title/tt0493264/?ref_=fn_tt_tt_1
2 http://www.imdb.com/title/tt2486682/?ref_=fn_tt_tt_1
  num_user_for_reviews language country content_rating  budget title_year
1                  159   Arabic  Turkey                8300000       2006
2                   42   Arabic   Egypt      Not Rated 1500000       2013
  actor_2_facebook_likes imdb_score aspect_ratio movie_facebook_likes
1                    197        6.0         1.85                  467
2                     10        8.1         1.85                    0
 [ reached 'max' / getOption("max.print") -- omitted 3 rows ]

moviesSub <- movies %>% filter(language == "English" | language == "Spanish")
moviesBig_Spanish <- movies %>% filter(language == "Spanish" | budget > 1e+10)

movies_eng_sp <- movies %>% filter(language == "English" | language == "Spanish") %>% 
    filter(budget > 1e+08)
dim(movies_eng_sp)

[1] 308  28

Arange

Order the rows

# single column
moviesBig_Spanish <- moviesBig_Spanish %>% arrange(desc(budget))

# arrange via multipe columns
moviesBig_Spanish <- moviesBig_Spanish %>% arrange(desc(budget), desc(title_year))

slice

Only see certain rows

movies_eng_sp %>% slice(c(35, 70))

  color    director_name num_critic_for_reviews duration
1 Color      Dan Scanlon                    376      104
2 Color Barry Sonnenfeld                     85      106
  director_facebook_likes actor_3_facebook_likes actor_2_name
1                      37                    760 Tyler Labine
2                     188                    582  Salma Hayek
  actor_1_facebook_likes     gross
1                  12000 268488329
2                  10000 113745408
                                     genres  actor_1_name
1 Adventure|Animation|Comedy|Family|Fantasy Steve Buscemi
2              Action|Comedy|Sci-Fi|Western    Will Smith
           movie_title num_voted_users cast_total_facebook_likes
1 Monsters University           235025                     14863
2      Wild Wild West           129601                     15870
  actor_3_name facenumber_in_poster
1   Sean Hayes                    0
2     Bai Ling                    2
                                            plot_keywords
1 cheating|fraternity|monster|singing in a car|university
2             buddy movie|general|inventor|steampunk|utah
                                       movie_imdb_link
1 http://www.imdb.com/title/tt1453405/?ref_=fn_tt_tt_1
2 http://www.imdb.com/title/tt0120891/?ref_=fn_tt_tt_1
  num_user_for_reviews language country content_rating  budget title_year
1                  265  English     USA              G 2.0e+08       2013
2                  648  English     USA          PG-13 1.7e+08       1999
  actor_2_facebook_likes imdb_score aspect_ratio movie_facebook_likes
1                    779        7.3         1.85                44000
2                   4000        4.8         1.85                    0

moviesBig_Spanish %>% slice(1:10)

  color director_name num_critic_for_reviews duration
1 Color  Joon-ho Bong                    363      110
2 Color  Carlos Saura                     35      115
  director_facebook_likes actor_3_facebook_likes       actor_2_name
1                     584                     74       Kang-ho Song
2                      98                      4 Juan Luis Galiardo
  actor_1_facebook_likes   gross                     genres actor_1_name
1                    629 2201412 Comedy|Drama|Horror|Sci-Fi    Doona Bae
2                    341 1687311              Drama|Musical  Mía Maestro
  movie_title num_voted_users cast_total_facebook_likes      actor_3_name
1   The Host            68883                      1173        Ah-sung Ko
2      Tango             2412                       371 Miguel Ángel Solá
  facenumber_in_poster                                 plot_keywords
1                    0        daughter|han river|monster|river|seoul
2                    3 dancer|director|love|musical filmmaking|tango
                                       movie_imdb_link
1 http://www.imdb.com/title/tt0468492/?ref_=fn_tt_tt_1
2 http://www.imdb.com/title/tt0120274/?ref_=fn_tt_tt_1
  num_user_for_reviews language     country content_rating      budget
1                  279   Korean South Korea              R 12215500000
2                   40  Spanish       Spain          PG-13   700000000
  title_year actor_2_facebook_likes imdb_score aspect_ratio
1       2006                    398        7.0         1.85
2       1998                     26        7.2         2.00
  movie_facebook_likes
1                 7000
2                  539
 [ reached 'max' / getOption("max.print") -- omitted 8 rows ]

select

Used to pick out certain variables

movies_sub <- movies %>% select(movie_title, director_name, gross, budget, )
dim(movies_sub)

[1] 5043    4

names(movies_sub)

[1] "movie_title"   "director_name" "gross"         "budget"       

movies <- movies %>% select(movie_title, director_name, gross, budget, everything())
names(movies)

 [1] "movie_title"               "director_name"            
 [3] "gross"                     "budget"                   
 [5] "color"                     "num_critic_for_reviews"   
 [7] "duration"                  "director_facebook_likes"  
 [9] "actor_3_facebook_likes"    "actor_2_name"             
[11] "actor_1_facebook_likes"    "genres"                   
[13] "actor_1_name"              "num_voted_users"          
[15] "cast_total_facebook_likes" "actor_3_name"             
[17] "facenumber_in_poster"      "plot_keywords"            
[19] "movie_imdb_link"           "num_user_for_reviews"     
[21] "language"                  "country"                  
[23] "content_rating"            "title_year"               
[25] "actor_2_facebook_likes"    "imdb_score"               
[27] "aspect_ratio"              "movie_facebook_likes"     

# using select to programmatically select several variables
moviesActors <- movies %>% select(starts_with("actor"))

Select Helpers

• starts_with(): Starts with a prefix.
• ends_with(): Ends with a suffix.
• contains(): Contains a literal string.
• matches(): Matches a regular expression.
• num_range(): Matches a numerical range like x01, x02, x03.
• one_of(): Matches variable names in a character vector.
• everything(): Matches all variables.
• last_col(): Select last variable, possibly with an offset.

rename

movies <- movies %>% rename(director = director_name)
names(movies)

 [1] "movie_title"               "director"                 
 [3] "gross"                     "budget"                   
 [5] "color"                     "num_critic_for_reviews"   
 [7] "duration"                  "director_facebook_likes"  
 [9] "actor_3_facebook_likes"    "actor_2_name"             
[11] "actor_1_facebook_likes"    "genres"                   
[13] "actor_1_name"              "num_voted_users"          
[15] "cast_total_facebook_likes" "actor_3_name"             
[17] "facenumber_in_poster"      "plot_keywords"            
[19] "movie_imdb_link"           "num_user_for_reviews"     
[21] "language"                  "country"                  
[23] "content_rating"            "title_year"               
[25] "actor_2_facebook_likes"    "imdb_score"               
[27] "aspect_ratio"              "movie_facebook_likes"     

mutate

movies <- movies %>% mutate(budgetM = budget/1e+06, grossM = gross/1e+06, profit = grossM - 
    budgetM) %>% filter(budgetM < 400)

group_by

Director_Tot <- movies %>% group_by(director) %>% summarize(grossTotDir = sum(grossM, 
    na.rm = TRUE))
head(Director_Tot)

# A tibble: 6 x 2
  director        grossTotDir
  <fct>                 <dbl>
1 ""                    0    
2 A. Raven Cruz         0    
3 Aaron Schneider       9.18 
4 Aaron Seltzer        48.5  
5 Abel Ferrara          1.23 
6 Adam Carolla          0.106

Summerize

Director_Stats <- movies %>% group_by(director) %>% summarize(n = n(), min = min(grossM), 
    max = max(grossM), avg = mean(grossM), sd = sd(grossM))

Director_Stats %>% arrange(desc(max)) %>% slice(1:10)

# A tibble: 10 x 6
   director              n    min   max   avg    sd
   <fct>             <int>  <dbl> <dbl> <dbl> <dbl>
 1 James Cameron         7  38.4   761.  278.  301.
 2 Colin Trevorrow       2   4.01  652.  328.  458.
 3 Joss Whedon           4  25.3   623.  433.  282.
 4 Christopher Nolan     8  25.5   533.  227.  187.
 5 George Lucas          5 115     475.  348.  146.
 6 Andrew Adamson        4 142.    436.  284.  121.
 7 Francis Lawrence      5  58.7   425.  272.  135.
 8 Gore Verbinski        7  12.5   423.  190.  154.
 9 Roger Allers          2  84.3   423.  254.  239.
10 Lee Unkrich           1 415.    415.  415.   NA 

Pulling it together

movies <- movies %>% mutate(genre_main = unlist(map(strsplit(as.character(movies$genres), 
    "\\|"), 1)), grossM = gross/1e+06, budgetM = budget/1e+06, profitM = grossM - 
    budgetM, ROI = profitM/budgetM)
movies <- movies %>% mutate(genre_main = factor(genre_main) %>% fct_drop())

Director_Avg <- movies %>% group_by(director) %>% summarize(num_movies = n(), 
    grossAvgDir = mean(grossM, na.rm = TRUE), profitAvgDir = mean(profit, na.rm = TRUE))

Director_Avg %>% arrange(desc(profitAvgDir)) %>% filter(num_movies > 1) %>% 
    slice(1:20)

# A tibble: 20 x 4
   director          num_movies grossAvgDir profitAvgDir
   <fct>                  <int>       <dbl>        <dbl>
 1 George Lucas               5        348.         277.
 2 Colin Trevorrow            2        328.         253.
 3 Joss Whedon                4        433.         250.
 4 Pierre Coffin              2        310.         237.
 5 Roger Allers               2        254.         189.
 6 James Cameron              7        278.         171.
 7 Pete Docter                3        313.         158.
 8 Francis Lawrence           5        272.         151.
 9 Irvin Kershner             2        173.         146.
10 Andrew Adamson             4        284.         131.
11 Joel Zwick                 2        145.         129.
12 George Roy Hill            2        131.         125.
13 Phil Lord                  4        178.         115.
14 Gary Ross                  3        183.         111.
15 Jon Favreau                7        223.         110.
16 Oren Peli                  2        108.         108.
17 Victor Fleming             3        110.         107.
18 Robert Wise                3        123.         101.
19 Christopher Nolan          8        227.         101.
20 Leonard Nimoy              3        118.         100.

Director_Avg %>% arrange(desc(num_movies)) %>% slice(1:20)

# A tibble: 20 x 4
   director          num_movies grossAvgDir profitAvgDir
   <fct>                  <int>       <dbl>        <dbl>
 1 Steven Spielberg          26       165.      99.5    
 2 Woody Allen               22        16.2     -0.00813
 3 Clint Eastwood            20        72.5     32.1    
 4 Martin Scorsese           18        57.2      0.0194 
 5 Ridley Scott              17        78.7     -5.43   
 6 Spike Lee                 16        21.9      5.26   
 7 Steven Soderbergh         16        65.7     25.5    
 8 Tim Burton                16       129.      51.5    
 9 Renny Harlin              15        34.9    -11.2    
10 Oliver Stone              14        52.3      7.67   
11 Barry Levinson            13        48.0     15.0    
12 John Carpenter            13        24.3      9.57   
13 Michael Bay               13       172.      49.6    
14 Robert Rodriguez          13        45.4     16.9    
15 Robert Zemeckis           13       125.      42.3    
16 Ron Howard                13       105.      28.5    
17 Sam Raimi                 13       171.      51.6    
18 Brian De Palma            12        50.1     10.3    
19 Joel Schumacher           12        63.2     13.8    
20 Kevin Smith               12        20.6      6.31   

Director_Tot <- movies %>% group_by(director) %>% summarize(grossTotDir = sum(grossM, 
    na.rm = TRUE))
genre_collapse <- movies %>% group_by(genre_main) %>% summarize(Avg_ROI_genre = mean(ROI, 
    na.rm = TRUE), SD_ROI_genre = sd(ROI, na.rm = TRUE), SE_ROI_genre = sd(ROI, 
    na.rm = TRUE)/sqrt(n()), num_films = n())

actor_sum <- movies %>% group_by(actor_1_name) %>% summarize(Avg_ROI_actor = mean(ROI, 
    na.rm = TRUE), SD_ROI_actor = sd(ROI, na.rm = TRUE), SE_ROI_actor = sd(ROI, 
    na.rm = TRUE)/sqrt(n()), num_films = n())

actor_sum %>% filter(num_films > 2) %>% top_n(5, wt = Avg_ROI_actor)

# A tibble: 5 x 5
  actor_1_name     Avg_ROI_actor SD_ROI_actor SE_ROI_actor num_films
  <fct>                    <dbl>        <dbl>        <dbl>     <int>
1 Gunnar Hansen            246.         211.        122.           3
2 Jamie Lee Curtis          47.0         70.2        20.3         12
3 Jon Heder                 36.7         63.8        36.8          3
4 Madeline Kahn             37.4         10.7         4.79         5
5 Michael Emerson           22.3         32.1        18.5          3

genre_collapse %>% select(SE_ROI_genre)

# A tibble: 19 x 1
   SE_ROI_genre
          <dbl>
 1        0.291
 2        0.276
 3        2.07 
 4       12.3  
 5        0.470
 6        0.232
 7        1.67 
 8        0.296
 9        7.14 
10        1.11 
11       NA    
12       NA    
13       40.1  
14       11.4  
15        0.476
16        1.08 
17        0.618
18        1.44 
19        0.471

genre_collapse$SE_ROI_genre

 [1]  0.2909999  0.2755208  2.0667876 12.3284782  0.4697230  0.2315017
 [7]  1.6732844  0.2963527  7.1413626  1.1121905         NA         NA
[13] 40.1424230 11.4088478  0.4763281  1.0834822  0.6181190  1.4418917
[19]  0.4705548

ggplot

ggplot2 is a system for declaratively creating graphics, based on The Grammar of Graphics. You provide the data, tell ggplot2 how to map variables to aesthetics, what graphical primitives to use, and it takes care of the details.

It’s hard to succinctly describe how ggplot2 works because it embodies a deep philosophy of visualisation. However, in most cases you start with ggplot(), supply a dataset and aesthetic mapping (with aes()). You then add on layers (like geom_point() or geom_histogram()), scales (like scale_colour_brewer()), faceting specifications (like facet_wrap()) and coordinate systems (like coord_flip()).

CHEATSHEET

Scatter

ggplot(mpg, aes(displ, hwy, colour = class)) + geom_point()

ggplot(data = movies) + geom_point(mapping = aes(x = imdb_score, y = budget))

Bar Plot

geom_bar makes the height of the bar proportional to the number of cases in each group (or if the weight aesthetic is supplied, the sum of the weights). If you want the heights of the bars to represent values in the data, use geom_col() instead. geom_bar() uses stat_count() by default: it counts the number of cases at each x position. geom_col() uses stat_identity(): it leaves the data as is.

ggplot(gmsc_train, aes(y = SeriousDlqin2yrs, x = age)) + geom_bar(stat = "identity", 
    fill = "red") + ggtitle("Serious Delinquencies in 2 years vs By Age") + 
    labs(x = "Age", y = "Serious Delinquencies in 2 years")

ggplot(gmsc_train, aes(y = SeriousDlqin2yrs, x = NumberRealEstateLoansOrLines)) + 
    geom_col(fill = "red") + ggtitle("Serious Delinquencies in 2 years vs Number of Loans or Lines") + 
    labs(x = "Number of Real Estate Loans Or Lines", y = "Serious Delinquencies in 2 years")

Jitter

The jitter geom is a convenient shortcut for geom_point(position = "jitter"). It adds a small amount of random variation to the location of each point, and is a useful way of handling overplotting caused by discreteness in smaller datasets.

ggplot(gmsc_train, aes(x = MonthlyIncome, y = SeriousDlqin2yrs)) + geom_jitter(alpha = 1/10, 
    color = "hotpink") + xlim(0, 1e+05) + ggtitle("Serious Delinquencies in 2 years vs Monthly Income") + 
    labs(x = "Monthly Income", y = "Serious Delinquencies in 2 years")

Histogram

Visualise the distribution of a single continuous variable by dividing the x axis into bins and counting the number of observations in each bin. Histograms (geom_histogram()) display the counts with bars; frequency polygons (geom_freqpoly()) display the counts with lines. Frequency polygons are more suitable when you want to compare the distribution across the levels of a categorical variable.

ggplot(diamonds, aes(carat)) + geom_histogram()

Box Plot

mpg %>% ggplot(aes(x = reorder(class, hwy), y = hwy, fill = class)) + geom_boxplot() + 
    xlab("class") + theme(legend.position = "none")

Line

In a line graph, observations are ordered by x value and connected.

The functions geom_line(), geom_step(), or geom_path() can be used.

x value (for x axis) can be :

• date : for a time series data
• texts
• discrete numeric values
• continuous numeric values

Data derived from ToothGrowth data sets are used. ToothGrowth describes the effect of Vitamin C on tooth growth in Guinea pigs.

• len - Tooth Length
• dose - Dose in mg (0.5, 1, 2)

See more here

df <- data.frame(dose = c("D0.5", "D1", "D2"), len = c(4.2, 10, 29.5))
head(df)

  dose  len
1 D0.5  4.2
2   D1 10.0
3   D2 29.5

# Basic line plot with points
ggplot(data = df, aes(x = dose, y = len, group = 1)) + geom_line() + geom_point()

# Change the line type
ggplot(data = df, aes(x = dose, y = len, group = 1)) + geom_line(linetype = "dashed") + 
    geom_point()

# Change the color
ggplot(data = df, aes(x = dose, y = len, group = 1)) + geom_line(color = "red") + 
    geom_point()

Observations can be also connected using the functions geom_step() or geom_path() :

ggplot(data = df, aes(x = dose, y = len, group = 1)) + geom_step() + geom_point()

ggplot(data = df, aes(x = dose, y = len, group = 1)) + geom_path() + geom_point()

Error Bars

ggplot(Genre_ROI, aes(y = ROI_avg, x = genre_main)) + geom_bar(stat = "identity") + 
    coord_flip() + ggtitle("Best Performing Genre By ROI") + geom_errorbar(mapping = aes(ymin = ROI_avg - 
    se_ROI, ymax = ROI_avg + se_ROI))

Lift charts

library(ISLR)
library(tidyverse)
data("Default")
library(caret)
logit_fit3 <- glm(default ~ balance, family = binomial, data = Default)
preds_DF <- data.frame(preds = predict(logit_fit3, type = "response"), true = factor(Default$default, 
    levels = c("Yes", "No")))
creditLift <- lift(true ~ preds, data = preds_DF)
xyplot(creditLift, main = "X = balance")

library("caret")
logit_fit2 <- glm(default ~ student, family = binomial, data = Default)
preds_DF <- data.frame(preds = predict(logit_fit2, type = "response"), true = factor(Default$default, 
    levels = c("Yes", "No")))
creditLift <- lift(true ~ preds, data = preds_DF)
xyplot(creditLift, main = "X = student")

Calibration charts

scores3DF <- data.frame(default = ifelse(Default$default == "Yes", 1, 0), scores = predict(logit_fit3, 
    type = "response"))
library(plyr)
calData <- ddply(scores3DF, .(cut(scores3DF$scores, c(0, 0.05, 0.15, 0.25, 0.35, 
    0.45, 0.55, 0.65, 0.75, 0.85, 0.95, 1))), colwise(mean))
calData$midpoint <- c(0.025, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 0.975)
colnames(calData) <- c("preds", "true", "midpoint")
calPlot <- ggplot(calData, aes(x = midpoint, y = true)) + geom_point() + ylim(0, 
    1) + geom_abline(intercept = 0, slope = 1, color = "red") + xlab("Prediction midpoint") + 
    ylab("Observed event percentage")
plot(calPlot)

Downsampling and up-sampling

library("ROSE")
data_rose_down <- ROSE(default ~ ., data = Default, N = 666, p = 1/2)

table(data_rose_down$data$default)

 No Yes 
343 323 

data_rose_up <- ROSE(default ~ ., data = Default, N = 12000, p = 1/2)
table(data_rose_up$data$default)

  No  Yes 
5970 6030 

# logit downsampled model
logit_down <- glm(default ~ balance, data = data_rose_down$data, family = "binomial")
summary(logit_down)

Call:
glm(formula = default ~ balance, family = "binomial", data = data_rose_down$data)

Deviance Residuals: 
     Min        1Q    Median        3Q       Max  
-2.85083  -0.44990  -0.07329   0.46241   2.69113  

Coefficients:
              Estimate Std. Error z value Pr(>|z|)    
(Intercept) -5.8991981  0.4664077  -12.65   <2e-16 ***
balance      0.0045741  0.0003464   13.20   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 922.67  on 665  degrees of freedom
Residual deviance: 455.61  on 664  degrees of freedom
AIC: 459.61

Number of Fisher Scoring iterations: 6

# logit up-sampled
logit_up <- glm(default ~ balance, data = data_rose_up$data, family = "binomial")
summary(logit_up)

Call:
glm(formula = default ~ balance, family = "binomial", data = data_rose_up$data)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-3.2894  -0.3638   0.0467   0.4305   3.0628  

Coefficients:
              Estimate Std. Error z value Pr(>|z|)    
(Intercept) -6.754e+00  1.267e-01  -53.32   <2e-16 ***
balance      5.136e-03  9.163e-05   56.05   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 16635.2  on 11999  degrees of freedom
Residual deviance:  7392.7  on 11998  degrees of freedom
AIC: 7396.7

Number of Fisher Scoring iterations: 6

# vanilla logit
logit <- glm(default ~ balance, data = Default, family = "binomial")

# generate scores and class predictions
scores_down = predict(logit_down, type = "response")

scores_up = predict(logit_up, type = "response")

scores_reg = predict(logit, type = "response")

class_down = ifelse(scores_down > 0.5, 1, 0)
class_up = ifelse(scores_up > 0.5, 1, 0)
class_reg = ifelse(scores_reg > 0.5, 1, 0)
# > diagnostics(table(data_rose_down$data$default,class_down)) Accuracy:
# 0.872 TP: 307 TN: 274 Sensitivity: 0.9 Specificity: 0.843 False Pos Rate:
# 0.157 > diagnostics(table(data_rose_up$data$default,class_up)) Accuracy:
# 0.869 TP: 5282 TN: 5149 Sensitivity: 0.88 Specificity: 0.859 False Pos
# Rate: 0.141 > diagnostics(table(Default$default,class_reg))

Resampling Methods

# Auto dataset
library(ISLR)
library(tidyverse)
set.seed(1861)
data(Auto)

Auto_sub <- Auto %>% select(-name)
head(Auto_sub)

  mpg cylinders displacement horsepower weight acceleration year origin
1  18         8          307        130   3504         12.0   70      1
2  15         8          350        165   3693         11.5   70      1
3  18         8          318        150   3436         11.0   70      1
4  16         8          304        150   3433         12.0   70      1
5  17         8          302        140   3449         10.5   70      1
6  15         8          429        198   4341         10.0   70      1

Leave one out cross-validation (LOOCV)

# for loop of model
mods_LOOCV <- list()
preds_LOOCV <- NULL
for (i in 1:nrow(Auto)) {
    mod = lm(mpg ~ ., data = Auto_sub %>% slice(-i))
    preds_LOOCV[i] <- predict(mod, newdata = slice(Auto_sub, i))
    mods_LOOCV[[i]] <- mod
}

head(preds_LOOCV)

[1] 14.92963 13.98084 15.17965 15.04054 14.91319 10.54207

mod_insample <- lm(mpg ~ ., data = Auto_sub)

# compute RMSE LOOCV
preds_DF <- data.frame(preds_LOOCV = preds_LOOCV, preds_insample = predict(mod_insample), 
    true = Auto$mpg)

library(caret)
RMSE(preds_DF$preds_LOOCV, preds_DF$true)

[1] 3.37211

RMSE(preds_DF$preds_insample, preds_DF$true)

[1] 3.293551

R2(preds_DF$preds_LOOCV, preds_DF$true)

[1] 0.8128915

R2(preds_DF$preds_insample, preds_DF$true)

[1] 0.8214781

k-fold Cross validation

Auto_sub <- mutate(Auto_sub, folds = createFolds(Auto_sub$mpg, k = 10, list = FALSE))

### K-Fold Cross Validation
nfolds <- 10
preds_10FoldCV_DF <- data.frame(folds = Auto_sub$folds, preds_10FoldCV = rep(NA, 
    nrow(Auto_sub)))
for (i in 1:nfolds) {
    mod <- lm(mpg ~ ., data = Auto_sub %>% filter(folds != i))
    preds <- predict(mod, newdata = filter(Auto_sub, folds == i))
    preds_10FoldCV_DF[preds_10FoldCV_DF$folds == i, "preds_10FoldCV"] <- preds
}


preds_DF <- data.frame(preds_10FoldCV = preds_10FoldCV_DF$preds_10FoldCV, preds_DF)

RMSE(preds_DF$preds_10FoldCV, preds_DF$true)

[1] 3.356499

RMSE(preds_DF$preds_LOOCV, preds_DF$true)

[1] 3.37211

RMSE(preds_DF$preds_insample, preds_DF$true)

[1] 3.293551

R2(preds_DF$preds_10FoldCV, preds_DF$true)

[1] 0.814659

R2(preds_DF$preds_LOOCV, preds_DF$true)

[1] 0.8128915

R2(preds_DF$preds_insample, preds_DF$true)

[1] 0.8214781

Bootstrapping

B = 100  # number of bootstraped datasets
n_boot = 200  # size of each bootstrapped sample
coef_boot = NULL
for (b in 1:B) {
    idx <- sample(1:nrow(Auto_sub), size = n_boot, replace = TRUE)
    mod <- lm(mpg ~ displacement, data = Auto_sub %>% slice(idx))
    coef_boot[b] <- mod$coefficients[2]
}

mod_lm <- lm(mpg ~ displacement, data = Auto_sub)

coef_boot <- data.frame(coef_boot = coef_boot)

ggplot(coef_boot, aes(x = coef_boot)) + geom_histogram() + geom_vline(xintercept = mod_lm$coefficients[2], 
    color = "red")

more complicated function for bootstrapping

library(rsample)
library(broom)
library(purrr)
library(boot)


boots <- bootstraps(Auto_sub, times = 100)
boots

# Bootstrap sampling 
# A tibble: 100 x 2
   splits            id          
   <list>            <chr>       
 1 <split [392/148]> Bootstrap001
 2 <split [392/142]> Bootstrap002
 3 <split [392/147]> Bootstrap003
 4 <split [392/136]> Bootstrap004
 5 <split [392/145]> Bootstrap005
 6 <split [392/146]> Bootstrap006
 7 <split [392/140]> Bootstrap007
 8 <split [392/142]> Bootstrap008
 9 <split [392/154]> Bootstrap009
10 <split [392/143]> Bootstrap010
# … with 90 more rows

fit_lm_on_boots <- function(split) {
    lm(mpg ~ displacement - 1, data = analysis(split))
}

boot_mods <- boots %>% mutate(model = map(splits, fit_lm_on_boots), coef_info = map(model, 
    tidy))

boot_coefs <- boot_mods %>% unnest(coef_info)

boot_coefs

# A tibble: 100 x 8
   splits      id       model term    estimate std.error statistic  p.value
   <list>      <chr>    <lis> <chr>      <dbl>     <dbl>     <dbl>    <dbl>
 1 <split [39… Bootstr… <lm>  displa…   0.0799   0.00389      20.5 3.83e-64
 2 <split [39… Bootstr… <lm>  displa…   0.0868   0.00420      20.7 1.16e-64
 3 <split [39… Bootstr… <lm>  displa…   0.0823   0.00418      19.7 2.38e-60
 4 <split [39… Bootstr… <lm>  displa…   0.0772   0.00387      20.0 1.39e-61
 5 <split [39… Bootstr… <lm>  displa…   0.0818   0.00414      19.8 8.06e-61
 6 <split [39… Bootstr… <lm>  displa…   0.0785   0.00391      20.1 3.81e-62
 7 <split [39… Bootstr… <lm>  displa…   0.0802   0.00378      21.2 7.05e-67
 8 <split [39… Bootstr… <lm>  displa…   0.0843   0.00405      20.8 3.29e-65
 9 <split [39… Bootstr… <lm>  displa…   0.0799   0.00378      21.1 1.30e-66
10 <split [39… Bootstr… <lm>  displa…   0.0765   0.00388      19.7 1.18e-60
# … with 90 more rows

ggplot(boot_coefs, aes(estimate)) + geom_histogram(bins = 20)

Forward Stepwise Selection

library("leaps")

auto_fit_fwd <- regsubsets(mpg ~ ., data = Auto_sub, nvmax = 7, method = "forward")

summary(auto_fit_fwd)

Subset selection object
Call: regsubsets.formula(mpg ~ ., data = Auto_sub, nvmax = 7, method = "forward")
8 Variables  (and intercept)
             Forced in Forced out
cylinders        FALSE      FALSE
displacement     FALSE      FALSE
horsepower       FALSE      FALSE
weight           FALSE      FALSE
acceleration     FALSE      FALSE
year             FALSE      FALSE
origin           FALSE      FALSE
folds            FALSE      FALSE
1 subsets of each size up to 7
Selection Algorithm: forward
         cylinders displacement horsepower weight acceleration year origin
1  ( 1 ) " "       " "          " "        "*"    " "          " "  " "   
2  ( 1 ) " "       " "          " "        "*"    " "          "*"  " "   
3  ( 1 ) " "       " "          " "        "*"    " "          "*"  "*"   
4  ( 1 ) " "       "*"          " "        "*"    " "          "*"  "*"   
5  ( 1 ) " "       "*"          "*"        "*"    " "          "*"  "*"   
6  ( 1 ) "*"       "*"          "*"        "*"    " "          "*"  "*"   
7  ( 1 ) "*"       "*"          "*"        "*"    "*"          "*"  "*"   
         folds
1  ( 1 ) " "  
2  ( 1 ) " "  
3  ( 1 ) " "  
4  ( 1 ) " "  
5  ( 1 ) " "  
6  ( 1 ) " "  
7  ( 1 ) " "  

plot(auto_fit_fwd, scale = "adjr2")

Backward Stepwise Selection

auto_fit_bkwd <- regsubsets(mpg ~ ., data = Auto_sub, nvmax = 7, method = "backward")
summary(auto_fit_bkwd)

Subset selection object
Call: regsubsets.formula(mpg ~ ., data = Auto_sub, nvmax = 7, method = "backward")
8 Variables  (and intercept)
             Forced in Forced out
cylinders        FALSE      FALSE
displacement     FALSE      FALSE
horsepower       FALSE      FALSE
weight           FALSE      FALSE
acceleration     FALSE      FALSE
year             FALSE      FALSE
origin           FALSE      FALSE
folds            FALSE      FALSE
1 subsets of each size up to 7
Selection Algorithm: backward
         cylinders displacement horsepower weight acceleration year origin
1  ( 1 ) " "       " "          " "        "*"    " "          " "  " "   
2  ( 1 ) " "       " "          " "        "*"    " "          "*"  " "   
3  ( 1 ) " "       " "          " "        "*"    " "          "*"  "*"   
4  ( 1 ) " "       "*"          " "        "*"    " "          "*"  "*"   
5  ( 1 ) " "       "*"          "*"        "*"    " "          "*"  "*"   
6  ( 1 ) "*"       "*"          "*"        "*"    " "          "*"  "*"   
7  ( 1 ) "*"       "*"          "*"        "*"    "*"          "*"  "*"   
         folds
1  ( 1 ) " "  
2  ( 1 ) " "  
3  ( 1 ) " "  
4  ( 1 ) " "  
5  ( 1 ) " "  
6  ( 1 ) " "  
7  ( 1 ) " "  

plot(auto_fit_bkwd, scale = "adjr2")

Linear Regression

Linear regression is a linear approach to modeling the relationship between a scalar response (or dependent variable) and one or more explanatory variables (or independent variables). The case of one explanatory variable is called simple linear regression. Generate a linear model with lm(), desired formula is written with the dependant variable followed by ~ and then a list of the independant variables Can use . for all, or do something like y ~ -director Can get the coefficients like this mod1$coefficients[1]

mod1 <- lm(gross ~ budget + duration, data = movies_train)
summary(mod1)

Call:
lm(formula = gross ~ budget + duration, data = movies_train)

Residuals:
       Min         1Q     Median         3Q        Max 
-214888240  -23184331   -9165431   12757656  488641764 

Coefficients:
              Estimate Std. Error t value Pr(>|t|)    
(Intercept) -1.415e+07  4.971e+06  -2.846  0.00445 ** 
budget       1.023e+00  2.344e-02  43.665  < 2e-16 ***
duration     2.443e+05  4.624e+04   5.284 1.36e-07 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 52570000 on 2927 degrees of freedom
  (474 observations deleted due to missingness)
Multiple R-squared:  0.4349,    Adjusted R-squared:  0.4345 
F-statistic:  1126 on 2 and 2927 DF,  p-value: < 2.2e-16

Logistic Regression

Logistic regression is a statistical model that in its basic form uses a logistic function to model a binary dependent variable, although many more complex extensions exist. In regression analysis, logistic regression (or logit regression) is estimating the parameters of a logistic model (a form of binary regression). Use function glm() notice the family = binomial

library(ISLR)
data(Default)
options(scipen = 9)
logitMod1 <- glm(factor(default) ~ balance, family = binomial, data = Default)

summary(logitMod1)

Call:
glm(formula = factor(default) ~ balance, family = binomial, data = Default)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-2.2697  -0.1465  -0.0589  -0.0221   3.7589  

Coefficients:
               Estimate  Std. Error z value Pr(>|z|)    
(Intercept) -10.6513306   0.3611574  -29.49   <2e-16 ***
balance       0.0054989   0.0002204   24.95   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 2920.6  on 9999  degrees of freedom
Residual deviance: 1596.5  on 9998  degrees of freedom
AIC: 1600.5

Number of Fisher Scoring iterations: 8

round(logitMod1$coefficients, 4)

(Intercept)     balance 
   -10.6513      0.0055 

logitMod2 <- glm(factor(default) ~ balance + student + income, family = binomial, 
    data = Default)

Ridge Regression

library(glmnet)
library(glmnetUtils)

# load the movies dataset
library("tidyverse")
options(scipen = 50)
set.seed(1861)
movies <- read.csv(here::here("datasets", "movie_metadata.csv"))
movies <- movies %>% filter(budget < 400000000) %>% filter(content_rating != 
    "", content_rating != "Not Rated", !is.na(gross))
movies <- movies %>% mutate(genre_main = unlist(map(strsplit(as.character(movies$genres), 
    "\\|"), 1)), grossM = gross/1000000, budgetM = budget/1000000, profitM = grossM - 
    budgetM)
movies <- movies %>% mutate(genre_main = fct_lump(genre_main, 5), content_rating = fct_lump(content_rating, 
    3), country = fct_lump(country, 2), cast_total_facebook_likes000s = cast_total_facebook_likes/1000, 
    ) %>% drop_na()

train_idx <- sample(1:nrow(movies), size = floor(0.75 * nrow(movies)))
movies_train <- movies %>% slice(train_idx)
movies_test <- movies %>% slice(-train_idx)

# estimate ridge mod
Ridge_mod <- cv.glmnet(profitM ~ ., data = movies_train %>% select(-c(director_name, 
    actor_1_name, actor_2_name, actor_3_name, plot_keywords, movie_imdb_link, 
    country, budgetM, grossM, genres, language, movie_title)), alpha = 0)

coef(Ridge_mod)

31 x 1 sparse Matrix of class "dgCMatrix"
                                              1
(Intercept)                   375.8728467164299
color                           3.3709229184702
color Black and White          -1.4710509793354
colorColor                      1.5332871913922
num_critic_for_reviews          0.0000661387495
duration                       -0.0560651087860
director_facebook_likes        -0.0001810292387
actor_3_facebook_likes          0.0002041101931
actor_1_facebook_likes         -0.0000430491628
gross                           0.0000008036590
num_voted_users                 0.0000290618332
cast_total_facebook_likes       0.0000061427897
facenumber_in_poster            0.0473720680504
num_user_for_reviews            0.0006816099097
content_ratingPG                1.1396240741168
content_ratingPG-13             0.2819483822036
content_ratingR                -0.9505434689214
content_ratingOther             0.5102102078375
budget                         -0.0000007517667
title_year                     -0.1874436349418
actor_2_facebook_likes         -0.0000069751333
imdb_score                      0.7207706122038
aspect_ratio                   -1.4278392481220
movie_facebook_likes            0.0000078108292
genre_mainAction               -2.6892740660307
genre_mainAdventure            -1.3700422837322
genre_mainComedy                2.0182528348528
genre_mainCrime                -1.0237554171846
genre_mainDrama                 0.5432805069308
genre_mainOther                 2.0246784070736
cast_total_facebook_likes000s   0.0147232247410

# explore how coefficients change as we change lambda
library(coefplot)
coefpath(Ridge_mod)

Lasso Regression

library(glmnet)
library(glmnetUtils)

# load the movies dataset
library("tidyverse")
options(scipen = 50)
set.seed(1861)
movies <- read.csv(here::here("datasets", "movie_metadata.csv"))
movies <- movies %>% filter(budget < 400000000) %>% filter(content_rating != 
    "", content_rating != "Not Rated", !is.na(gross))
movies <- movies %>% mutate(genre_main = unlist(map(strsplit(as.character(movies$genres), 
    "\\|"), 1)), grossM = gross/1000000, budgetM = budget/1000000, profitM = grossM - 
    budgetM)
movies <- movies %>% mutate(genre_main = fct_lump(genre_main, 5), content_rating = fct_lump(content_rating, 
    3), country = fct_lump(country, 2), cast_total_facebook_likes000s = cast_total_facebook_likes/1000) %>% 
    drop_na() %>% select(-c(director_name, actor_1_name, actor_2_name, actor_3_name, 
    plot_keywords, movie_imdb_link, country, budgetM, grossM, genres, language, 
    movie_title, budget, gross))

train_idx <- sample(1:nrow(movies), size = floor(0.75 * nrow(movies)))
movies_train <- movies %>% slice(train_idx)
movies_test <- movies %>% slice(-train_idx)
# estimate Lasso mod
Lasso_mod <- 
cv.glmnet(profitM ~ ., data = movies_train, alpha = 1)

coef(Lasso_mod, s = Lasso_mod$lambda.min)

29 x 1 sparse Matrix of class "dgCMatrix"
                                             1
(Intercept)                   1817.52597097060
color                            6.21718603947
color Black and White          -16.32634322052
colorColor                       .            
num_critic_for_reviews           0.02200497574
duration                        -0.23340304359
director_facebook_likes         -0.00116426095
actor_3_facebook_likes          -0.00888584852
actor_1_facebook_likes          -0.00744714247
num_voted_users                  0.00018764443
cast_total_facebook_likes        0.00730527750
facenumber_in_poster             0.01932334558
num_user_for_reviews            -0.00141989884
content_ratingPG                 6.78067685064
content_ratingPG-13              .            
content_ratingR                -10.13906160797
content_ratingOther              0.31165685136
title_year                      -0.89939854327
actor_2_facebook_likes          -0.00725731678
imdb_score                       2.28958064135
aspect_ratio                    -5.96032233036
movie_facebook_likes            -0.00003218491
genre_mainAction               -13.02280025232
genre_mainAdventure             -5.60996877473
genre_mainComedy                 5.46476603293
genre_mainCrime                -10.53303103402
genre_mainDrama                  .            
genre_mainOther                  5.92525059365
cast_total_facebook_likes000s    0.01839641166

coef(Lasso_mod, s = Lasso_mod$lambda.1se)

29 x 1 sparse Matrix of class "dgCMatrix"
                                           1
(Intercept)                   719.9698526732
color                           .           
color Black and White           .           
colorColor                      .           
num_critic_for_reviews          .           
duration                       -0.0043326804
director_facebook_likes         .           
actor_3_facebook_likes          .           
actor_1_facebook_likes          .           
num_voted_users                 0.0001601412
cast_total_facebook_likes       .           
facenumber_in_poster            .           
num_user_for_reviews            .           
content_ratingPG                0.9868246546
content_ratingPG-13             .           
content_ratingR                -5.8747524831
content_ratingOther             .           
title_year                     -0.3569338609
actor_2_facebook_likes          .           
imdb_score                      .           
aspect_ratio                   -2.7581949479
movie_facebook_likes            .           
genre_mainAction               -4.1613186904
genre_mainAdventure             .           
genre_mainComedy                3.2939157095
genre_mainCrime                 .           
genre_mainDrama                 .           
genre_mainOther                 .           
cast_total_facebook_likes000s   .           

# put in a matrix
coef_mat <- data.frame(varname = rownames(coef(Lasso_mod)) %>% data.frame(), 
    Lasso_min = as.matrix(coef(Lasso_mod, s = Lasso_mod$lambda.min)) %>% round(3), 
    Lasso_1se = as.matrix(coef(Lasso_mod, s = Lasso_mod$lambda.1se)) %>% round(3)) %>% 
    rename(varname = 1, Lasso_min = 2, Lasso_1se = 3) %>% remove_rownames()

coef_mat

                     varname Lasso_min Lasso_1se
1                (Intercept)  1817.526   719.970
2                      color     6.217     0.000
3      color Black and White   -16.326     0.000
4                 colorColor     0.000     0.000
5     num_critic_for_reviews     0.022     0.000
6                   duration    -0.233    -0.004
7    director_facebook_likes    -0.001     0.000
8     actor_3_facebook_likes    -0.009     0.000
9     actor_1_facebook_likes    -0.007     0.000
10           num_voted_users     0.000     0.000
11 cast_total_facebook_likes     0.007     0.000
12      facenumber_in_poster     0.019     0.000
13      num_user_for_reviews    -0.001     0.000
14          content_ratingPG     6.781     0.987
15       content_ratingPG-13     0.000     0.000
16           content_ratingR   -10.139    -5.875
17       content_ratingOther     0.312     0.000
18                title_year    -0.899    -0.357
19    actor_2_facebook_likes    -0.007     0.000
20                imdb_score     2.290     0.000
21              aspect_ratio    -5.960    -2.758
22      movie_facebook_likes     0.000     0.000
23          genre_mainAction   -13.023    -4.161
24       genre_mainAdventure    -5.610     0.000
25          genre_mainComedy     5.465     3.294
 [ reached 'max' / getOption("max.print") -- omitted 4 rows ]

plot(Lasso_mod)

# place in one coef


# explore how coefficients change as we change lambda
library(coefplot)
coefpath(Lasso_mod)

ElasticNet

alpha_list <- seq(0, 1, len = 5)
alpha_list

[1] 0.00 0.25 0.50 0.75 1.00

enet_fit <- cva.glmnet(profitM ~ ., data = movies_train, alpha = alpha_list)

enet_fit

Call:
cva.glmnet.formula(formula = profitM ~ ., data = movies_train, 
    alpha = alpha_list)

Model fitting options:
    Sparse model matrix: FALSE
    Use model.frame: FALSE
    Alpha values: 0 0.25 0.5 0.75 1
    Number of crossvalidation folds for lambda: 10

minlossplot(enet_fit)

plot(enet_fit)

# look at each individual model
plot(enet_fit$modlist[[4]])

# view coefficients
coef(enet_fit, alpha = 0.75) %>% round(3)

29 x 1 sparse Matrix of class "dgCMatrix"
                                    1
(Intercept)                   507.144
color                           .    
color Black and White           .    
colorColor                      .    
num_critic_for_reviews          .    
duration                        .    
director_facebook_likes         .    
actor_3_facebook_likes          .    
actor_1_facebook_likes          .    
num_voted_users                 0.000
cast_total_facebook_likes       .    
facenumber_in_poster            .    
num_user_for_reviews            .    
content_ratingPG                .    
content_ratingPG-13             .    
content_ratingR                -3.881
content_ratingOther             .    
title_year                     -0.252
actor_2_facebook_likes          .    
imdb_score                      .    
aspect_ratio                   -1.041
movie_facebook_likes            .    
genre_mainAction               -1.895
genre_mainAdventure             .    
genre_mainComedy                1.382
genre_mainCrime                 .    
genre_mainDrama                 .    
genre_mainOther                 .    
cast_total_facebook_likes000s   .    

# if we want the lambda.min version
coef(enet_fit, alpha = 0.75, s = enet_fit$modlist[[4]]$lambda.min)

29 x 1 sparse Matrix of class "dgCMatrix"
                                             1
(Intercept)                   1824.83456917791
color                            6.78406927311
color Black and White          -16.42216538689
colorColor                       .            
num_critic_for_reviews           0.02243286736
duration                        -0.23490224956
director_facebook_likes         -0.00116390727
actor_3_facebook_likes          -0.00935228173
actor_1_facebook_likes          -0.00777160447
num_voted_users                  0.00018773817
cast_total_facebook_likes        0.00531736364
facenumber_in_poster             0.02480761575
num_user_for_reviews            -0.00154877509
content_ratingPG                 6.80214813322
content_ratingPG-13              .            
content_ratingR                -10.12517852647
content_ratingOther              0.32191366168
title_year                      -0.90314657015
actor_2_facebook_likes          -0.00758867152
imdb_score                       2.32360789565
aspect_ratio                    -5.95505883297
movie_facebook_likes            -0.00003347691
genre_mainAction               -13.15425499855
genre_mainAdventure             -5.73089418600
genre_mainComedy                 5.34359619040
genre_mainCrime                -10.66799259723
genre_mainDrama                  .            
genre_mainOther                  5.87709172623
cast_total_facebook_likes000s    2.33040943783

coef(enet_fit, alpha = 1) %>% round(3)

29 x 1 sparse Matrix of class "dgCMatrix"
                                    1
(Intercept)                   523.253
color                           .    
color Black and White           .    
colorColor                      .    
num_critic_for_reviews          .    
duration                        .    
director_facebook_likes         .    
actor_3_facebook_likes          .    
actor_1_facebook_likes          .    
num_voted_users                 0.000
cast_total_facebook_likes       .    
facenumber_in_poster            .    
num_user_for_reviews            .    
content_ratingPG                .    
content_ratingPG-13             .    
content_ratingR                -3.980
content_ratingOther             .    
title_year                     -0.261
actor_2_facebook_likes          .    
imdb_score                      .    
aspect_ratio                   -1.063
movie_facebook_likes            .    
genre_mainAction               -2.099
genre_mainAdventure             .    
genre_mainComedy                1.550
genre_mainCrime                 .    
genre_mainDrama                 .    
genre_mainOther                 .    
cast_total_facebook_likes000s   .    

enet_coefs <- data.frame(varname = rownames(coef(enet_fit, alpha = 0)), ridge = as.matrix(coef(enet_fit, 
    alpha = 0)) %>% round(3), alpha025 = as.matrix(coef(enet_fit, alpha = 0.25)) %>% 
    round(3), alpha05 = as.matrix(coef(enet_fit, alpha = 0.5)) %>% round(3), 
    alpha075 = as.matrix(coef(enet_fit, alpha = 0.75)) %>% round(3), lasso = as.matrix(coef(enet_fit, 
        alpha = 1)) %>% round(3)) %>% rename(varname = 1, ridge = 2, alpha025 = 3, 
    alpha05 = 4, alpha075 = 5, lasso = 6) %>% remove_rownames()

Predict

scores <- predict(logitMod1, type = "response")
head(scores)

           1            2            3            4            5 
0.0013056797 0.0021125949 0.0085947405 0.0004344368 0.0017769574 
           6 
0.0037041528 

preds_DF <- data.frame(scores_mod1 = predict(logitMod1, type = "response"), 
    scores_mod2 = predict(logitMod2, type = "response"), Default)

Confusion Matrix

library("caret")
confusionMatrix(factor(ifelse(preds_DF$scores_mod1 > 0.5, "Yes", "No"), levels = c("Yes", 
    "No")), factor(preds_DF$default, levels = c("Yes", "No")))

Confusion Matrix and Statistics

          Reference
Prediction  Yes   No
       Yes  100   42
       No   233 9625
                                               
               Accuracy : 0.9725               
                 95% CI : (0.9691, 0.9756)     
    No Information Rate : 0.9667               
    P-Value [Acc > NIR] : 0.0004973            
                                               
                  Kappa : 0.4093               
                                               
 Mcnemar's Test P-Value : < 0.00000000000000022
                                               
            Sensitivity : 0.3003               
            Specificity : 0.9957               
         Pos Pred Value : 0.7042               
         Neg Pred Value : 0.9764               
             Prevalence : 0.0333               
         Detection Rate : 0.0100               
   Detection Prevalence : 0.0142               
      Balanced Accuracy : 0.6480               
                                               
       'Positive' Class : Yes                  
                                               

ROC Curve

TrainDF <- data.frame(default = c(Default$default, Default$default), scores = c(preds_DF$scores_mod1, 
    preds_DF$scores_mod2), models = c(rep("X = Student", length(preds_DF$scores_mod1)), 
    rep("X = Student + Balance + Income", length(preds_DF$scores_mod2))))


library(ggplot2)
library("plotROC")
TrainROC <- ggplot(TrainDF, aes(m = scores, d = default, color = models)) + 
    geom_roc(show.legend = TRUE, labelsize = 3.5, cutoffs.at = c(0.99, 0.9, 
        0.7, 0.5, 0.3, 0.1, 0))
TrainROC <- TrainROC + style_roc(theme = theme_grey) + theme(axis.text = element_text(colour = "blue")) + 
    theme(legend.justification = c(1, 0), legend.position = c(1, 0), legend.box.margin = margin(c(50, 
        50, 50, 50)))
plot(TrainROC)

Calibration Plot

load library(plyr) before library(tidyverse)

scores3DF <- data.frame(default = ifelse(Default$default == "Yes", 1, 0), scores = preds_DF$scores_mod2)

calData <- ddply(scores3DF, .(cut(scores3DF$scores, c(0, 0.05, 0.15, 0.25, 0.35, 
    0.45, 0.55, 0.65, 0.75, 0.85, 0.95, 1))), colwise(mean))
calData$midpoint <- c(0.025, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 0.975)
colnames(calData) <- c("preds", "true", "midpoint")
calPlot <- ggplot(calData, aes(x = midpoint, y = true)) + geom_point() + ylim(0, 
    1) + geom_abline(intercept = 0, slope = 1, color = "red") + xlab("Prediction midpoint") + 
    ylab("Observed event percentage")

plot(calPlot)